library(tidyverse)
library(mgnet)
mg <- readRDS("cache/gs_netw_filt.rds") %>%
  filter_taxa(!(comm_id %in% "7"))
mg
==== mgnet Object Summary ====
General Info:
  Samples: 912
  Taxa: 1235
  Only normalized data available.
  Sample Meta Info: Region, country_alt, city, year , etc... 
  Taxa Meta Info: source, type, kingdom_ncbi, phylum_ncbi , etc... 
  Network: 26071 edges, ~3.42% density
  Detected Communities: 6
  Community Sizes: 318, 247, 126, 113, 101 
  Isolated Nodes: 0 
==== End of mgnet Object Summary ====
# Create visual properties of the network, one by one
mg <- mg %>%
  # Color at family level for mOTU
  mutate_taxa(family_fct = if_else(is.na(family_ncbi), 
                                   "Unknown", family_ncbi)) %>%
  mutate_taxa(family_fct = fct_lump_n(family_fct, 20)) %>%
  colorize_taxa(family_fct, color_to = "color_family", 
                colorspace = list(h = c(0, 360), s = c(.2, .6), l = c(.7, .9))) %>% 
  mutate_taxa(color_family = case_when(
    family_fct == "Unknown" ~ "#D3D3D3",
    family_fct == "Other" ~ "#F7F7F7",
    TRUE ~ color_family
  )) %>%
  # I switch manually at two important families to make it more evident in the 
  # final results
  mutate_taxa(color_family = case_when(
    family_fct == "Pseudomonadaceae" ~ "#8FA4DAFF",  
    family_fct == "Neisseriaceae" ~ "#EBE7DAFF",
    family_fct == "Enterobacteriaceae" ~ "#E393D9FF",
    family_fct == "Aeromonadaceae" ~ "#CBA8B7FF",
    TRUE ~ color_family
  )) %>%
  # Color for amr classes
  mutate_taxa(class_amr_fct = factor(class_amr)) %>% 
  mutate_taxa(class_amr_fct = fct_lump_min(class_amr_fct, 10, other_level = "['other']"), .by = "") %>%
  colorize_taxa(class_amr_fct, color_to = "color_class_amr") %>%
  mutate_taxa(color_class_amr = if_else(class_amr_fct == "['other']", "#F7F7F7", color_class_amr)) %>%
  # Create a new column color_nodes where summarize amr and mOTU colors
  mutate_taxa(color_nodes = if_else(source == "mOTU", color_family, color_class_amr),
              color_nodes = if_else(source == "mOTU", 
                                    adjustcolor(color_family, alpha.f = .85),
                                    color_class_amr)) %>%
  # Color for the edges of the nodes
  mutate_taxa(vertex.frame.color = case_when(
    type == "mOTU" ~ "#838B83",
    type == "acquired" ~ "#8B0000",
    type == "functional" ~ "#008B45"
  )) %>%
  # Communities colors
  mutate_taxa(comm_id_fct = factor(comm_id)) %>%
  colorize_taxa(comm_id_fct, color_to = "color_comm", 
                colorspace = list(h = c(0, 360), s = c(.5, 1), l = c(.4,.7))) %>%
  mutate_taxa(color_comm = adjustcolor(color_comm, alpha.f = .6))
# Create named vector for the colors useful to create the legends
color_family <- gather_taxa(mg) %>%
  select(family_fct, color_family) %>%
  distinct() %>%
  deframe() 

color_amr <- gather_taxa(mg) %>%
  select(class_amr_fct, color_class_amr) %>%
  filter(!is.na(class_amr_fct)) %>%
  distinct() %>%
  deframe()
names(color_amr) <- names(color_amr) %>%
  str_remove_all("\\[") %>% str_remove_all("\\]") %>% str_remove_all("'")
#color_amr["other"] <- "#F7F7F7"

color_comm <- gather_taxa(mg) %>%
  select(comm_id_fct, color_comm) %>%
  filter(!is.na(comm_id_fct)) %>%
  distinct() %>%
  deframe()
color_comm <- color_comm[as.character(1:ncomm(mg))]
# generic star vertex shape, with a parameter for number of rays
# respect the igraph example i add the frame color and width
mystar <- function(coords, v=NULL, params) {
  vertex.color <- params("vertex", "color")
  if (length(vertex.color) != 1 && !is.null(v)) {
    vertex.color <- vertex.color[v]
  }
  vertex.size  <- 1/200 * params("vertex", "size")
  if (length(vertex.size) != 1 && !is.null(v)) {
    vertex.size <- vertex.size[v]
  }
  vertex.frame.color <- params("vertex", "frame.color")
  if (length(vertex.frame.color) != 1 && !is.null(v)) {
    vertex.frame.color <- vertex.frame.color[v]
  }
  vertex.frame.width <- params("vertex", "frame.width")
  if (length(vertex.frame.width) != 1 && !is.null(v)) {
    vertex.frame.width <- vertex.frame.width[v]
  }
  norays <- params("vertex", "norays")
  if (length(norays) != 1 && !is.null(v)) {
    norays <- norays[v]
  }

  mapply(coords[,1], coords[,2], vertex.color, 
         vertex.frame.color, vertex.frame.width,
         vertex.size, norays,
         FUN=function(x, y, bg, fg, lwd, size, nor) {
           symbols(x=x, y=y, bg=bg, fg=fg, lwd=lwd,
                   stars=matrix(c(size,size/2), nrow=1, ncol=nor*2),
                   add=TRUE, inches=FALSE)
         })
}
# no clipping, edges will be below the vertices anyway
add_shape("star", clip=shape_noclip,
                 plot=mystar, parameters=list(vertex.norays=5))

Start Plots one by one

Community plot network

x <- mg %>%
  select_link(weight > 0) %>%
  group_taxa(comm_id) %>%
  mutate_netw(eig_pos_comm = eigen_centrality(netw)$vector) %>%
  filter_taxa(eig_pos_comm > quantile(eig_pos_comm, 0.25)) %>%
  mutate_netw(deg_comm = degree(netw)) %>%
  filter_taxa(deg_comm >= 3) %>%
  deselect_link() %>%
  ungroup_taxa()


set.seed(42)
layout_x <- layout_signed(netw(x), layout = with_graphopt(
  spring.length = 1,
  mass = 100,
  charge = .003
))

x_inv <- x[, ntaxa(x):1]
layout_x_inv <- layout_x[ntaxa(x):1, ]
png(filename = "intermediate/network_community.png", 
    width = 4200, height = 4200, res = 300)

par(mar=c(0,0,0,0))
plot(x,
     layout = layout_x,
     vertex.label = NA,
     posCol = rgb(0, 0, 1, .2), negCol = rgb(1, 0, 0, .2),
     widthFactor = .75,
     vertex.shape = if_else(pull_taxa(x,source) == "mOTU", "circle", "star"),
     vertex.size = colMeans(norm(x)),
     maxSize = 6, expFactor = 0.5, sumConst = 1,
     vertex.frame.width = 3,
     vertex.color = if_else(pull_taxa(x,is_from_gut), "#CD6839", adjustcolor("#FFFACD", alpha.f = .5)),
     vertex.frame.color = pull_taxa(x, color_comm))

legend(
  x = 1.1, y = -.92, xjust = 1,
  legend = names(color_comm),
  col = color_comm,
  pch = 1, cex = 1.9,
  pt.cex = 2.5, bty = "n", lwd = 3,
  title = "Communities", horiz = T
)

legend(
  x = -1.1, y = -.92, xjust = 0,
  legend = c("Human mOTU", "Other mOTU", "amr"),
  col = c("#CD6839",  adjustcolor("#FFFACD", alpha.f = .5), "black"),
  pch = c(19,19,11), cex = 1.9,
  pt.cex = 2.5, bty = "n",
  title = "Source", horiz = T
)
dev.off()
null device 
          1 
png(filename = "intermediate/network_taxonomy_only.png", width = 4200, height = 4200, res = 300)

par(mar=c(0,0,0,0))
plot(x,
     layout = layout_x,
     vertex.label = NA,
     posCol = rgb(0, 0, 1, .2), negCol = rgb(1, 0, 0, .2),
     widthFactor = .75,
     vertex.shape = if_else(pull_taxa(x,source) == "mOTU", "circle", "star"),
     vertex.size = colMeans(norm(x)),
     maxSize = 6, expFactor = 0.5, sumConst = 1,
     vertex.color = pull_taxa(x, color_nodes),
     vertex.frame.color = pull_taxa(x, vertex.frame.color),
     vertex.frame.width = if_else(pull_taxa(x,source) == "mOTU", .5, 2))



dev.off()
null device 
          1 

Plot with only the legends of the networks

png(filename = "intermediate/netw_legend.png", width = 5250, height = 2100, res = 300)
plot.new()
par(mar = c(0,0,0,0))

legend(x = -.082, y = 1.1, xjust = 0,
       legend = tolower(names(color_family)), fill = color_family, title = "mOTU family", 
       y.intersp = 1.2,
       ncol = 2, bty = "n", cex = 2, title.adj = 0)

legend(x = .55, y = 1.1, xjust = 0,
       y.intersp = 1.2,
       legend = names(color_amr), fill = color_amr, title = "AMR class", 
       ncol = 1, bty = "n", title.adj = 0, cex = 2)

legend(
  x = -.05, y = 0, xjust = 0, cex = 2,
  legend = c("mOTU","acquired","functional"),
  pch = c(1,11,11),
  col = c("#838B83", "#8B0000", "#008B45"),
  pt.cex = 2, bty = "n",
  title = "Source", horiz = T,
  lwd = 2, title.adj = 0
)

legend(
  x = 0.465, y = 0, xjust = 0, cex = 2,
  legend = c("Positive", "Negative"),
  lty = c(1, 1),       
  col = c("blue", "red"),  
  lwd = 5,             
  bty = "n",           
  horiz = TRUE,
  title = "Link Weights", title.adj = 0, 
)

legend(
  x = 0.85, y = 0, xjust = 0, cex = 2,
  x.intersp = c(1,1.75),
  y.intersp = 1.75,
  legend = c("", "", ""),
  pt.cex = c(4,6,8),        
  pch = 21,                     
  pt.bg = "gray15",     
  bty = "n",           
  horiz = TRUE,
  title = "Mean CLR", title.adj = 0, 
)
dev.off()
null device 
          1 
df_bar <- gather_taxa(mg) %>%
  mutate(who = case_when(
    type == "acquired" ~ "Acquired ARGs",
    type == "functional" ~ "FG ARGs",
    #comm_id == "4" & species_uhgg == "Klebsiella grimontii" & is_from_gut == TRUE ~ "human enterobacteriaceae",
    is_from_gut ~ "Human-Gut mOTUs",
    family_ncbi == "Enterobacteriaceae" ~ "Enterobacteriaceae",
    family_ncbi == "Pseudomonadaceae" ~ "Pseudomonadaceae",
    is.na(family_ncbi) ~ "Unclassified mOTUs",
    TRUE ~ "Other mOTUs"
  )) %>%
  mutate(who = factor(who, levels = c("Acquired ARGs", "FG ARGs","Human-Gut mOTUs", 
                                      "Enterobacteriaceae", "Pseudomonadaceae",
                                      "Other mOTUs", "Unclassified mOTUs"))) %>%
  group_by(comm_id, who, color_comm) %>%
  summarise(n = n(), .groups = "drop") 

p_bar <- df_bar %>%
  mutate(comm_id = factor(comm_id, levels = as.character(1:7))) %>%
  ggplot(aes(x = comm_id, y = n, fill = who)) +
  geom_bar(stat = "identity") +
  theme_bw() +
  scale_fill_manual(values = c("Acquired ARGs" = "#8B0000", "FG ARGs" = "#008B45",
                               "Human-Gut mOTUs" = "#CD6839", 
                               "Unclassified mOTUs" = "#D3D3D3",
                               #"human enterobacteriaceae" = "black",
                               "Pseudomonadaceae" = "#8FA4DAFF",
                               "Enterobacteriaceae" = "#E393D9FF",
                               "Other mOTUs" = "#FFFACD")) +
  theme(axis.title.y = element_blank()) +
  labs(fill = "Source") +
  xlab("Communities") +
  theme(legend.position = "right") +
  theme(
    axis.text = element_text(size = 20),
    axis.text.x = element_text(size = 20, face = "bold"),
    axis.title.x = element_text(size = 20),
    legend.text = element_text(size = 20),       
    legend.title = element_text(size = 24),     
    legend.key.size = unit(2.5, "lines"),
    plot.margin = margin(t = 100, r = 20, b = 40, l = 60)
  ) 

Merge The Plots

library(png)
library(grid)
library(ggpubr)
p_taxa <- rasterGrob(readPNG("intermediate/network_taxonomy_only.png"), interpolate = TRUE)
p_comm <- rasterGrob(readPNG("intermediate/network_community.png"), interpolate = TRUE)
p_leg <- rasterGrob(readPNG("intermediate/netw_legend.png"), interpolate = TRUE)
all_plot <- ggpubr::ggarrange(
  p_taxa,
  p_comm,
  p_leg,
  p_bar,
  
  heights = c(2, 1),
  labels = c("a", "b", "","c"),
  font.label = list(size = 32),
  label.x = c(.15,.15,0,.05),
  label.y = c(.9,.9,0,.95)
  
)
all_plot

png(filename = "../plots/networks.png", width = 2*8400, height = 2*6300, res = 600)
all_plot
dev.off()
null device 
          1 
pdf(file = "../plots/networks.pdf", width = 28, height = 21)
all_plot
dev.off()
null device 
          1 
saveRDS(mg, "cache/gs_netw_filt_with_graphics.rds")
LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKYGBge3IsIG1lc3NhZ2U9RkFMU0V9CmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KG1nbmV0KQpgYGAKCmBgYHtyfQptZyA8LSByZWFkUkRTKCJjYWNoZS9nc19uZXR3X2ZpbHQucmRzIikgJT4lCiAgZmlsdGVyX3RheGEoIShjb21tX2lkICVpbiUgIjciKSkKbWcKYGBgCgpgYGB7cn0KIyBDcmVhdGUgdmlzdWFsIHByb3BlcnRpZXMgb2YgdGhlIG5ldHdvcmssIG9uZSBieSBvbmUKbWcgPC0gbWcgJT4lCiAgIyBDb2xvciBhdCBmYW1pbHkgbGV2ZWwgZm9yIG1PVFUKICBtdXRhdGVfdGF4YShmYW1pbHlfZmN0ID0gaWZfZWxzZShpcy5uYShmYW1pbHlfbmNiaSksIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJVbmtub3duIiwgZmFtaWx5X25jYmkpKSAlPiUKICBtdXRhdGVfdGF4YShmYW1pbHlfZmN0ID0gZmN0X2x1bXBfbihmYW1pbHlfZmN0LCAyMCkpICU+JQogIGNvbG9yaXplX3RheGEoZmFtaWx5X2ZjdCwgY29sb3JfdG8gPSAiY29sb3JfZmFtaWx5IiwgCiAgICAgICAgICAgICAgICBjb2xvcnNwYWNlID0gbGlzdChoID0gYygwLCAzNjApLCBzID0gYyguMiwgLjYpLCBsID0gYyguNywgLjkpKSkgJT4lIAogIG11dGF0ZV90YXhhKGNvbG9yX2ZhbWlseSA9IGNhc2Vfd2hlbigKICAgIGZhbWlseV9mY3QgPT0gIlVua25vd24iIH4gIiNEM0QzRDMiLAogICAgZmFtaWx5X2ZjdCA9PSAiT3RoZXIiIH4gIiNGN0Y3RjciLAogICAgVFJVRSB+IGNvbG9yX2ZhbWlseQogICkpICU+JQogICMgSSBzd2l0Y2ggbWFudWFsbHkgYXQgdHdvIGltcG9ydGFudCBmYW1pbGllcyB0byBtYWtlIGl0IG1vcmUgZXZpZGVudCBpbiB0aGUgCiAgIyBmaW5hbCByZXN1bHRzCiAgbXV0YXRlX3RheGEoY29sb3JfZmFtaWx5ID0gY2FzZV93aGVuKAogICAgZmFtaWx5X2ZjdCA9PSAiUHNldWRvbW9uYWRhY2VhZSIgfiAiIzhGQTREQUZGIiwgIAogICAgZmFtaWx5X2ZjdCA9PSAiTmVpc3NlcmlhY2VhZSIgfiAiI0VCRTdEQUZGIiwKICAgIGZhbWlseV9mY3QgPT0gIkVudGVyb2JhY3RlcmlhY2VhZSIgfiAiI0UzOTNEOUZGIiwKICAgIGZhbWlseV9mY3QgPT0gIkFlcm9tb25hZGFjZWFlIiB+ICIjQ0JBOEI3RkYiLAogICAgVFJVRSB+IGNvbG9yX2ZhbWlseQogICkpICU+JQogICMgQ29sb3IgZm9yIGFtciBjbGFzc2VzCiAgbXV0YXRlX3RheGEoY2xhc3NfYW1yX2ZjdCA9IGZhY3RvcihjbGFzc19hbXIpKSAlPiUgCiAgbXV0YXRlX3RheGEoY2xhc3NfYW1yX2ZjdCA9IGZjdF9sdW1wX21pbihjbGFzc19hbXJfZmN0LCAxMCwgb3RoZXJfbGV2ZWwgPSAiWydvdGhlciddIiksIC5ieSA9ICIiKSAlPiUKICBjb2xvcml6ZV90YXhhKGNsYXNzX2Ftcl9mY3QsIGNvbG9yX3RvID0gImNvbG9yX2NsYXNzX2FtciIpICU+JQogIG11dGF0ZV90YXhhKGNvbG9yX2NsYXNzX2FtciA9IGlmX2Vsc2UoY2xhc3NfYW1yX2ZjdCA9PSAiWydvdGhlciddIiwgIiNGN0Y3RjciLCBjb2xvcl9jbGFzc19hbXIpKSAlPiUKICAjIENyZWF0ZSBhIG5ldyBjb2x1bW4gY29sb3Jfbm9kZXMgd2hlcmUgc3VtbWFyaXplIGFtciBhbmQgbU9UVSBjb2xvcnMKICBtdXRhdGVfdGF4YShjb2xvcl9ub2RlcyA9IGlmX2Vsc2Uoc291cmNlID09ICJtT1RVIiwgY29sb3JfZmFtaWx5LCBjb2xvcl9jbGFzc19hbXIpLAogICAgICAgICAgICAgIGNvbG9yX25vZGVzID0gaWZfZWxzZShzb3VyY2UgPT0gIm1PVFUiLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgYWRqdXN0Y29sb3IoY29sb3JfZmFtaWx5LCBhbHBoYS5mID0gLjg1KSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgY29sb3JfY2xhc3NfYW1yKSkgJT4lCiAgIyBDb2xvciBmb3IgdGhlIGVkZ2VzIG9mIHRoZSBub2RlcwogIG11dGF0ZV90YXhhKHZlcnRleC5mcmFtZS5jb2xvciA9IGNhc2Vfd2hlbigKICAgIHR5cGUgPT0gIm1PVFUiIH4gIiM4MzhCODMiLAogICAgdHlwZSA9PSAiYWNxdWlyZWQiIH4gIiM4QjAwMDAiLAogICAgdHlwZSA9PSAiZnVuY3Rpb25hbCIgfiAiIzAwOEI0NSIKICApKSAlPiUKICAjIENvbW11bml0aWVzIGNvbG9ycwogIG11dGF0ZV90YXhhKGNvbW1faWRfZmN0ID0gZmFjdG9yKGNvbW1faWQpKSAlPiUKICBjb2xvcml6ZV90YXhhKGNvbW1faWRfZmN0LCBjb2xvcl90byA9ICJjb2xvcl9jb21tIiwgCiAgICAgICAgICAgICAgICBjb2xvcnNwYWNlID0gbGlzdChoID0gYygwLCAzNjApLCBzID0gYyguNSwgMSksIGwgPSBjKC40LC43KSkpICU+JQogIG11dGF0ZV90YXhhKGNvbG9yX2NvbW0gPSBhZGp1c3Rjb2xvcihjb2xvcl9jb21tLCBhbHBoYS5mID0gLjYpKQpgYGAKCmBgYHtyfQojIENyZWF0ZSBuYW1lZCB2ZWN0b3IgZm9yIHRoZSBjb2xvcnMgdXNlZnVsIHRvIGNyZWF0ZSB0aGUgbGVnZW5kcwpjb2xvcl9mYW1pbHkgPC0gZ2F0aGVyX3RheGEobWcpICU+JQogIHNlbGVjdChmYW1pbHlfZmN0LCBjb2xvcl9mYW1pbHkpICU+JQogIGRpc3RpbmN0KCkgJT4lCiAgZGVmcmFtZSgpIAoKY29sb3JfYW1yIDwtIGdhdGhlcl90YXhhKG1nKSAlPiUKICBzZWxlY3QoY2xhc3NfYW1yX2ZjdCwgY29sb3JfY2xhc3NfYW1yKSAlPiUKICBmaWx0ZXIoIWlzLm5hKGNsYXNzX2Ftcl9mY3QpKSAlPiUKICBkaXN0aW5jdCgpICU+JQogIGRlZnJhbWUoKQpuYW1lcyhjb2xvcl9hbXIpIDwtIG5hbWVzKGNvbG9yX2FtcikgJT4lCiAgc3RyX3JlbW92ZV9hbGwoIlxcWyIpICU+JSBzdHJfcmVtb3ZlX2FsbCgiXFxdIikgJT4lIHN0cl9yZW1vdmVfYWxsKCInIikKI2NvbG9yX2Ftclsib3RoZXIiXSA8LSAiI0Y3RjdGNyIKCmNvbG9yX2NvbW0gPC0gZ2F0aGVyX3RheGEobWcpICU+JQogIHNlbGVjdChjb21tX2lkX2ZjdCwgY29sb3JfY29tbSkgJT4lCiAgZmlsdGVyKCFpcy5uYShjb21tX2lkX2ZjdCkpICU+JQogIGRpc3RpbmN0KCkgJT4lCiAgZGVmcmFtZSgpCmNvbG9yX2NvbW0gPC0gY29sb3JfY29tbVthcy5jaGFyYWN0ZXIoMTpuY29tbShtZykpXQpgYGAKCmBgYHtyfQojIGdlbmVyaWMgc3RhciB2ZXJ0ZXggc2hhcGUsIHdpdGggYSBwYXJhbWV0ZXIgZm9yIG51bWJlciBvZiByYXlzCiMgcmVzcGVjdCB0aGUgaWdyYXBoIGV4YW1wbGUgaSBhZGQgdGhlIGZyYW1lIGNvbG9yIGFuZCB3aWR0aApteXN0YXIgPC0gZnVuY3Rpb24oY29vcmRzLCB2PU5VTEwsIHBhcmFtcykgewogIHZlcnRleC5jb2xvciA8LSBwYXJhbXMoInZlcnRleCIsICJjb2xvciIpCiAgaWYgKGxlbmd0aCh2ZXJ0ZXguY29sb3IpICE9IDEgJiYgIWlzLm51bGwodikpIHsKICAgIHZlcnRleC5jb2xvciA8LSB2ZXJ0ZXguY29sb3Jbdl0KICB9CiAgdmVydGV4LnNpemUgIDwtIDEvMjAwICogcGFyYW1zKCJ2ZXJ0ZXgiLCAic2l6ZSIpCiAgaWYgKGxlbmd0aCh2ZXJ0ZXguc2l6ZSkgIT0gMSAmJiAhaXMubnVsbCh2KSkgewogICAgdmVydGV4LnNpemUgPC0gdmVydGV4LnNpemVbdl0KICB9CiAgdmVydGV4LmZyYW1lLmNvbG9yIDwtIHBhcmFtcygidmVydGV4IiwgImZyYW1lLmNvbG9yIikKICBpZiAobGVuZ3RoKHZlcnRleC5mcmFtZS5jb2xvcikgIT0gMSAmJiAhaXMubnVsbCh2KSkgewogICAgdmVydGV4LmZyYW1lLmNvbG9yIDwtIHZlcnRleC5mcmFtZS5jb2xvclt2XQogIH0KICB2ZXJ0ZXguZnJhbWUud2lkdGggPC0gcGFyYW1zKCJ2ZXJ0ZXgiLCAiZnJhbWUud2lkdGgiKQogIGlmIChsZW5ndGgodmVydGV4LmZyYW1lLndpZHRoKSAhPSAxICYmICFpcy5udWxsKHYpKSB7CiAgICB2ZXJ0ZXguZnJhbWUud2lkdGggPC0gdmVydGV4LmZyYW1lLndpZHRoW3ZdCiAgfQogIG5vcmF5cyA8LSBwYXJhbXMoInZlcnRleCIsICJub3JheXMiKQogIGlmIChsZW5ndGgobm9yYXlzKSAhPSAxICYmICFpcy5udWxsKHYpKSB7CiAgICBub3JheXMgPC0gbm9yYXlzW3ZdCiAgfQoKICBtYXBwbHkoY29vcmRzWywxXSwgY29vcmRzWywyXSwgdmVydGV4LmNvbG9yLCAKICAgICAgICAgdmVydGV4LmZyYW1lLmNvbG9yLCB2ZXJ0ZXguZnJhbWUud2lkdGgsCiAgICAgICAgIHZlcnRleC5zaXplLCBub3JheXMsCiAgICAgICAgIEZVTj1mdW5jdGlvbih4LCB5LCBiZywgZmcsIGx3ZCwgc2l6ZSwgbm9yKSB7CiAgICAgICAgICAgc3ltYm9scyh4PXgsIHk9eSwgYmc9YmcsIGZnPWZnLCBsd2Q9bHdkLAogICAgICAgICAgICAgICAgICAgc3RhcnM9bWF0cml4KGMoc2l6ZSxzaXplLzIpLCBucm93PTEsIG5jb2w9bm9yKjIpLAogICAgICAgICAgICAgICAgICAgYWRkPVRSVUUsIGluY2hlcz1GQUxTRSkKICAgICAgICAgfSkKfQojIG5vIGNsaXBwaW5nLCBlZGdlcyB3aWxsIGJlIGJlbG93IHRoZSB2ZXJ0aWNlcyBhbnl3YXkKYWRkX3NoYXBlKCJzdGFyIiwgY2xpcD1zaGFwZV9ub2NsaXAsCiAgICAgICAgICAgICAgICAgcGxvdD1teXN0YXIsIHBhcmFtZXRlcnM9bGlzdCh2ZXJ0ZXgubm9yYXlzPTUpKQpgYGAKCiMjIFN0YXJ0IFBsb3RzIG9uZSBieSBvbmUKCiMjIyBDb21tdW5pdHkgcGxvdCBuZXR3b3JrCgpgYGB7ciwgZmlnLndpZHRoPTE0LCBmaWcuaGVpZ2h0PTE0fQp4IDwtIG1nICU+JQogIHNlbGVjdF9saW5rKHdlaWdodCA+IDApICU+JQogIGdyb3VwX3RheGEoY29tbV9pZCkgJT4lCiAgbXV0YXRlX25ldHcoZWlnX3Bvc19jb21tID0gZWlnZW5fY2VudHJhbGl0eShuZXR3KSR2ZWN0b3IpICU+JQogIGZpbHRlcl90YXhhKGVpZ19wb3NfY29tbSA+IHF1YW50aWxlKGVpZ19wb3NfY29tbSwgMC4yNSkpICU+JQogIG11dGF0ZV9uZXR3KGRlZ19jb21tID0gZGVncmVlKG5ldHcpKSAlPiUKICBmaWx0ZXJfdGF4YShkZWdfY29tbSA+PSAzKSAlPiUKICBkZXNlbGVjdF9saW5rKCkgJT4lCiAgdW5ncm91cF90YXhhKCkKCgpzZXQuc2VlZCg0MikKbGF5b3V0X3ggPC0gbGF5b3V0X3NpZ25lZChuZXR3KHgpLCBsYXlvdXQgPSB3aXRoX2dyYXBob3B0KAogIHNwcmluZy5sZW5ndGggPSAxLAogIG1hc3MgPSAxMDAsCiAgY2hhcmdlID0gLjAwMwopKQoKeF9pbnYgPC0geFssIG50YXhhKHgpOjFdCmxheW91dF94X2ludiA8LSBsYXlvdXRfeFtudGF4YSh4KToxLCBdCmBgYAoKCmBgYHtyLCBmaWcud2lkdGg9MTQsIGZpZy5oZWlnaHQ9MTR9CnBuZyhmaWxlbmFtZSA9ICJpbnRlcm1lZGlhdGUvbmV0d29ya19jb21tdW5pdHkucG5nIiwgCiAgICB3aWR0aCA9IDQyMDAsIGhlaWdodCA9IDQyMDAsIHJlcyA9IDMwMCkKCnBhcihtYXI9YygwLDAsMCwwKSkKcGxvdCh4LAogICAgIGxheW91dCA9IGxheW91dF94LAogICAgIHZlcnRleC5sYWJlbCA9IE5BLAogICAgIHBvc0NvbCA9IHJnYigwLCAwLCAxLCAuMiksIG5lZ0NvbCA9IHJnYigxLCAwLCAwLCAuMiksCiAgICAgd2lkdGhGYWN0b3IgPSAuNzUsCiAgICAgdmVydGV4LnNoYXBlID0gaWZfZWxzZShwdWxsX3RheGEoeCxzb3VyY2UpID09ICJtT1RVIiwgImNpcmNsZSIsICJzdGFyIiksCiAgICAgdmVydGV4LnNpemUgPSBjb2xNZWFucyhub3JtKHgpKSwKICAgICBtYXhTaXplID0gNiwgZXhwRmFjdG9yID0gMC41LCBzdW1Db25zdCA9IDEsCiAgICAgdmVydGV4LmZyYW1lLndpZHRoID0gMywKICAgICB2ZXJ0ZXguY29sb3IgPSBpZl9lbHNlKHB1bGxfdGF4YSh4LGlzX2Zyb21fZ3V0KSwgIiNDRDY4MzkiLCBhZGp1c3Rjb2xvcigiI0ZGRkFDRCIsIGFscGhhLmYgPSAuNSkpLAogICAgIHZlcnRleC5mcmFtZS5jb2xvciA9IHB1bGxfdGF4YSh4LCBjb2xvcl9jb21tKSkKCmxlZ2VuZCgKICB4ID0gMS4xLCB5ID0gLS45MiwgeGp1c3QgPSAxLAogIGxlZ2VuZCA9IG5hbWVzKGNvbG9yX2NvbW0pLAogIGNvbCA9IGNvbG9yX2NvbW0sCiAgcGNoID0gMSwgY2V4ID0gMS45LAogIHB0LmNleCA9IDIuNSwgYnR5ID0gIm4iLCBsd2QgPSAzLAogIHRpdGxlID0gIkNvbW11bml0aWVzIiwgaG9yaXogPSBUCikKCmxlZ2VuZCgKICB4ID0gLTEuMSwgeSA9IC0uOTIsIHhqdXN0ID0gMCwKICBsZWdlbmQgPSBjKCJIdW1hbiBtT1RVIiwgIk90aGVyIG1PVFUiLCAiYW1yIiksCiAgY29sID0gYygiI0NENjgzOSIsICBhZGp1c3Rjb2xvcigiI0ZGRkFDRCIsIGFscGhhLmYgPSAuNSksICJibGFjayIpLAogIHBjaCA9IGMoMTksMTksMTEpLCBjZXggPSAxLjksCiAgcHQuY2V4ID0gMi41LCBidHkgPSAibiIsCiAgdGl0bGUgPSAiU291cmNlIiwgaG9yaXogPSBUCikKZGV2Lm9mZigpCmBgYAoKYGBge3IsIGZpZy53aWR0aD0xNCwgZmlnLmhlaWdodD0xNH0KcG5nKGZpbGVuYW1lID0gImludGVybWVkaWF0ZS9uZXR3b3JrX3RheG9ub215X29ubHkucG5nIiwgd2lkdGggPSA0MjAwLCBoZWlnaHQgPSA0MjAwLCByZXMgPSAzMDApCgpwYXIobWFyPWMoMCwwLDAsMCkpCnBsb3QoeCwKICAgICBsYXlvdXQgPSBsYXlvdXRfeCwKICAgICB2ZXJ0ZXgubGFiZWwgPSBOQSwKICAgICBwb3NDb2wgPSByZ2IoMCwgMCwgMSwgLjIpLCBuZWdDb2wgPSByZ2IoMSwgMCwgMCwgLjIpLAogICAgIHdpZHRoRmFjdG9yID0gLjc1LAogICAgIHZlcnRleC5zaGFwZSA9IGlmX2Vsc2UocHVsbF90YXhhKHgsc291cmNlKSA9PSAibU9UVSIsICJjaXJjbGUiLCAic3RhciIpLAogICAgIHZlcnRleC5zaXplID0gY29sTWVhbnMobm9ybSh4KSksCiAgICAgbWF4U2l6ZSA9IDYsIGV4cEZhY3RvciA9IDAuNSwgc3VtQ29uc3QgPSAxLAogICAgIHZlcnRleC5jb2xvciA9IHB1bGxfdGF4YSh4LCBjb2xvcl9ub2RlcyksCiAgICAgdmVydGV4LmZyYW1lLmNvbG9yID0gcHVsbF90YXhhKHgsIHZlcnRleC5mcmFtZS5jb2xvciksCiAgICAgdmVydGV4LmZyYW1lLndpZHRoID0gaWZfZWxzZShwdWxsX3RheGEoeCxzb3VyY2UpID09ICJtT1RVIiwgLjUsIDIpKQoKCgpkZXYub2ZmKCkKYGBgCgojIFBsb3Qgd2l0aCBvbmx5IHRoZSBsZWdlbmRzIG9mIHRoZSBuZXR3b3JrcwoKYGBge3IsIGZpZy53aWR0aD0xNy41LCBmaWcuaGVpZ2h0PTd9CnBuZyhmaWxlbmFtZSA9ICJpbnRlcm1lZGlhdGUvbmV0d19sZWdlbmQucG5nIiwgd2lkdGggPSA1MjUwLCBoZWlnaHQgPSAyMTAwLCByZXMgPSAzMDApCnBsb3QubmV3KCkKcGFyKG1hciA9IGMoMCwwLDAsMCkpCgpsZWdlbmQoeCA9IC0uMDgyLCB5ID0gMS4xLCB4anVzdCA9IDAsCiAgICAgICBsZWdlbmQgPSB0b2xvd2VyKG5hbWVzKGNvbG9yX2ZhbWlseSkpLCBmaWxsID0gY29sb3JfZmFtaWx5LCB0aXRsZSA9ICJtT1RVIGZhbWlseSIsIAogICAgICAgeS5pbnRlcnNwID0gMS4yLAogICAgICAgbmNvbCA9IDIsIGJ0eSA9ICJuIiwgY2V4ID0gMiwgdGl0bGUuYWRqID0gMCkKCmxlZ2VuZCh4ID0gLjU1LCB5ID0gMS4xLCB4anVzdCA9IDAsCiAgICAgICB5LmludGVyc3AgPSAxLjIsCiAgICAgICBsZWdlbmQgPSBuYW1lcyhjb2xvcl9hbXIpLCBmaWxsID0gY29sb3JfYW1yLCB0aXRsZSA9ICJBTVIgY2xhc3MiLCAKICAgICAgIG5jb2wgPSAxLCBidHkgPSAibiIsIHRpdGxlLmFkaiA9IDAsIGNleCA9IDIpCgpsZWdlbmQoCiAgeCA9IC0uMDUsIHkgPSAwLCB4anVzdCA9IDAsIGNleCA9IDIsCiAgbGVnZW5kID0gYygibU9UVSIsImFjcXVpcmVkIiwiZnVuY3Rpb25hbCIpLAogIHBjaCA9IGMoMSwxMSwxMSksCiAgY29sID0gYygiIzgzOEI4MyIsICIjOEIwMDAwIiwgIiMwMDhCNDUiKSwKICBwdC5jZXggPSAyLCBidHkgPSAibiIsCiAgdGl0bGUgPSAiU291cmNlIiwgaG9yaXogPSBULAogIGx3ZCA9IDIsIHRpdGxlLmFkaiA9IDAKKQoKbGVnZW5kKAogIHggPSAwLjQ2NSwgeSA9IDAsIHhqdXN0ID0gMCwgY2V4ID0gMiwKICBsZWdlbmQgPSBjKCJQb3NpdGl2ZSIsICJOZWdhdGl2ZSIpLAogIGx0eSA9IGMoMSwgMSksICAgICAgIAogIGNvbCA9IGMoImJsdWUiLCAicmVkIiksICAKICBsd2QgPSA1LCAgICAgICAgICAgICAKICBidHkgPSAibiIsICAgICAgICAgICAKICBob3JpeiA9IFRSVUUsCiAgdGl0bGUgPSAiTGluayBXZWlnaHRzIiwgdGl0bGUuYWRqID0gMCwgCikKCmxlZ2VuZCgKICB4ID0gMC44NSwgeSA9IDAsIHhqdXN0ID0gMCwgY2V4ID0gMiwKICB4LmludGVyc3AgPSBjKDEsMS43NSksCiAgeS5pbnRlcnNwID0gMS43NSwKICBsZWdlbmQgPSBjKCIiLCAiIiwgIiIpLAogIHB0LmNleCA9IGMoNCw2LDgpLCAgICAgICAgCiAgcGNoID0gMjEsICAgICAgICAgICAgICAgICAgICAgCiAgcHQuYmcgPSAiZ3JheTE1IiwgICAgIAogIGJ0eSA9ICJuIiwgICAgICAgICAgIAogIGhvcml6ID0gVFJVRSwKICB0aXRsZSA9ICJNZWFuIENMUiIsIHRpdGxlLmFkaiA9IDAsIAopCmRldi5vZmYoKQpgYGAKCmBgYHtyLCBmaWcud2lkdGg9MTAuNSwgZmlnLmhlaWdodD01fQpkZl9iYXIgPC0gZ2F0aGVyX3RheGEobWcpICU+JQogIG11dGF0ZSh3aG8gPSBjYXNlX3doZW4oCiAgICB0eXBlID09ICJhY3F1aXJlZCIgfiAiQWNxdWlyZWQgQVJHcyIsCiAgICB0eXBlID09ICJmdW5jdGlvbmFsIiB+ICJGRyBBUkdzIiwKICAgICNjb21tX2lkID09ICI0IiAmIHNwZWNpZXNfdWhnZyA9PSAiS2xlYnNpZWxsYSBncmltb250aWkiICYgaXNfZnJvbV9ndXQgPT0gVFJVRSB+ICJodW1hbiBlbnRlcm9iYWN0ZXJpYWNlYWUiLAogICAgaXNfZnJvbV9ndXQgfiAiSHVtYW4tR3V0IG1PVFVzIiwKICAgIGZhbWlseV9uY2JpID09ICJFbnRlcm9iYWN0ZXJpYWNlYWUiIH4gIkVudGVyb2JhY3RlcmlhY2VhZSIsCiAgICBmYW1pbHlfbmNiaSA9PSAiUHNldWRvbW9uYWRhY2VhZSIgfiAiUHNldWRvbW9uYWRhY2VhZSIsCiAgICBpcy5uYShmYW1pbHlfbmNiaSkgfiAiVW5jbGFzc2lmaWVkIG1PVFVzIiwKICAgIFRSVUUgfiAiT3RoZXIgbU9UVXMiCiAgKSkgJT4lCiAgbXV0YXRlKHdobyA9IGZhY3Rvcih3aG8sIGxldmVscyA9IGMoIkFjcXVpcmVkIEFSR3MiLCAiRkcgQVJHcyIsIkh1bWFuLUd1dCBtT1RVcyIsIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJFbnRlcm9iYWN0ZXJpYWNlYWUiLCAiUHNldWRvbW9uYWRhY2VhZSIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIk90aGVyIG1PVFVzIiwgIlVuY2xhc3NpZmllZCBtT1RVcyIpKSkgJT4lCiAgZ3JvdXBfYnkoY29tbV9pZCwgd2hvLCBjb2xvcl9jb21tKSAlPiUKICBzdW1tYXJpc2UobiA9IG4oKSwgLmdyb3VwcyA9ICJkcm9wIikgCgpwX2JhciA8LSBkZl9iYXIgJT4lCiAgbXV0YXRlKGNvbW1faWQgPSBmYWN0b3IoY29tbV9pZCwgbGV2ZWxzID0gYXMuY2hhcmFjdGVyKDE6NykpKSAlPiUKICBnZ3Bsb3QoYWVzKHggPSBjb21tX2lkLCB5ID0gbiwgZmlsbCA9IHdobykpICsKICBnZW9tX2JhcihzdGF0ID0gImlkZW50aXR5IikgKwogIHRoZW1lX2J3KCkgKwogIHNjYWxlX2ZpbGxfbWFudWFsKHZhbHVlcyA9IGMoIkFjcXVpcmVkIEFSR3MiID0gIiM4QjAwMDAiLCAiRkcgQVJHcyIgPSAiIzAwOEI0NSIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiSHVtYW4tR3V0IG1PVFVzIiA9ICIjQ0Q2ODM5IiwgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiVW5jbGFzc2lmaWVkIG1PVFVzIiA9ICIjRDNEM0QzIiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICMiaHVtYW4gZW50ZXJvYmFjdGVyaWFjZWFlIiA9ICJibGFjayIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiUHNldWRvbW9uYWRhY2VhZSIgPSAiIzhGQTREQUZGIiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJFbnRlcm9iYWN0ZXJpYWNlYWUiID0gIiNFMzkzRDlGRiIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiT3RoZXIgbU9UVXMiID0gIiNGRkZBQ0QiKSkgKwogIHRoZW1lKGF4aXMudGl0bGUueSA9IGVsZW1lbnRfYmxhbmsoKSkgKwogIGxhYnMoZmlsbCA9ICJTb3VyY2UiKSArCiAgeGxhYigiQ29tbXVuaXRpZXMiKSArCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gInJpZ2h0IikgKwogIHRoZW1lKAogICAgYXhpcy50ZXh0ID0gZWxlbWVudF90ZXh0KHNpemUgPSAyMCksCiAgICBheGlzLnRleHQueCA9IGVsZW1lbnRfdGV4dChzaXplID0gMjAsIGZhY2UgPSAiYm9sZCIpLAogICAgYXhpcy50aXRsZS54ID0gZWxlbWVudF90ZXh0KHNpemUgPSAyMCksCiAgICBsZWdlbmQudGV4dCA9IGVsZW1lbnRfdGV4dChzaXplID0gMjApLCAgICAgICAKICAgIGxlZ2VuZC50aXRsZSA9IGVsZW1lbnRfdGV4dChzaXplID0gMjQpLCAgICAgCiAgICBsZWdlbmQua2V5LnNpemUgPSB1bml0KDIuNSwgImxpbmVzIiksCiAgICBwbG90Lm1hcmdpbiA9IG1hcmdpbih0ID0gMTAwLCByID0gMjAsIGIgPSA0MCwgbCA9IDYwKQogICkgCmBgYAoKIyMgTWVyZ2UgVGhlIFBsb3RzCgpgYGB7cn0KbGlicmFyeShwbmcpCmxpYnJhcnkoZ3JpZCkKbGlicmFyeShnZ3B1YnIpCnBfdGF4YSA8LSByYXN0ZXJHcm9iKHJlYWRQTkcoImludGVybWVkaWF0ZS9uZXR3b3JrX3RheG9ub215X29ubHkucG5nIiksIGludGVycG9sYXRlID0gVFJVRSkKcF9jb21tIDwtIHJhc3Rlckdyb2IocmVhZFBORygiaW50ZXJtZWRpYXRlL25ldHdvcmtfY29tbXVuaXR5LnBuZyIpLCBpbnRlcnBvbGF0ZSA9IFRSVUUpCnBfbGVnIDwtIHJhc3Rlckdyb2IocmVhZFBORygiaW50ZXJtZWRpYXRlL25ldHdfbGVnZW5kLnBuZyIpLCBpbnRlcnBvbGF0ZSA9IFRSVUUpCmBgYAoKYGBge3IsIGZpZy53aWR0aD0yOCwgZmlnLmhlaWdodD0gMjF9CmFsbF9wbG90IDwtIGdncHVicjo6Z2dhcnJhbmdlKAogIHBfdGF4YSwKICBwX2NvbW0sCiAgcF9sZWcsCiAgcF9iYXIsCiAgCiAgaGVpZ2h0cyA9IGMoMiwgMSksCiAgbGFiZWxzID0gYygiYSIsICJiIiwgIiIsImMiKSwKICBmb250LmxhYmVsID0gbGlzdChzaXplID0gMzIpLAogIGxhYmVsLnggPSBjKC4xNSwuMTUsMCwuMDUpLAogIGxhYmVsLnkgPSBjKC45LC45LDAsLjk1KQogIAopCmFsbF9wbG90CmBgYAoKYGBge3J9CnBuZyhmaWxlbmFtZSA9ICIuLi9wbG90cy9uZXR3b3Jrcy5wbmciLCB3aWR0aCA9IDIqODQwMCwgaGVpZ2h0ID0gMio2MzAwLCByZXMgPSA2MDApCmFsbF9wbG90CmRldi5vZmYoKQpgYGAKCmBgYHtyfQpwZGYoZmlsZSA9ICIuLi9wbG90cy9uZXR3b3Jrcy5wZGYiLCB3aWR0aCA9IDI4LCBoZWlnaHQgPSAyMSkKYWxsX3Bsb3QKZGV2Lm9mZigpCmBgYAoKYGBge3J9CnNhdmVSRFMobWcsICJjYWNoZS9nc19uZXR3X2ZpbHRfd2l0aF9ncmFwaGljcy5yZHMiKQpgYGAKCg==